perm filename WRDCNT[0,BGB] blob
sn#126791 filedate 1974-10-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE WRDCNT
C00007 00003 EXTERN JOBFF,JOBREL
C00009 00004 FILNAM: SIXBIT/ANA/
C00010 00005 SA:
C00011 00006
C00012 ENDMK
C⊗;
TITLE WRDCNT
OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF DZM[SETZM]↔OPDEF GO[JRST]
OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
↓P←←17
DEFINE POP0J<POPJ P,>
↓POP1J.:↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2 ;DECLARE ACCUMULATORS.
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){FOR VARNAM⊂(LIST)<VARNAM:0↔>}
DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
%←400000
DEFINE CAT $(A,B){A$B} ;CONCATENATION.
.PLEVEL←←0 ↔ .SLEVEL←←0 ;PDL COUNT & DEPTH OF SUBR NESTING.
;SUBROUTINE DECLARATION MACROS - SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
↓NAME:;}
;DEFINE ARGUMENT NAME MACRO.
DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }
;SUBROUTINE CALLING MACROS - CALL & SETQ.
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
IFDIF<><NAME>{PUSHJ P,NAME }
.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;STACK ACCESSING MACROS - PUSHP & POPP.
DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
DEFINE POPP(ARG) {POP P,ARG↔.PLEVEL←←.PLEVEL-1}
EXTERN JOBFF,JOBREL
SUBR(INFILE) INDIRECT FILE COMMAND "@".
COMMENT .-----------------------------------------------------------.
;FILE INITIALIZATION.
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM↔HALT
;EXPAND CORE WHEN NECESSARY.
HLRE PPPN↔MOVMS↔DAC SIZE# ;WORD COUNT.
IMULI =5↔DAC CHRCNT ;NEW CHARACTER COUNT.
LAC 1,TXTORG↔ADD 1,SIZE↔DAP 1,JOBFF ;NEW TOP OF CORE.
CDR 1,JOBFF↔CAMG 1,JOBREL↔GO .+3 ;EXPAND CORE.
CORE 1,↔HALT
;INPUT THE FILE.
CDR TXTORG↔HRLI 700↔DAC TXTPTR ;RESET TEXT POINTER.
HLL PPPN↔DAC DUMARG ;DUMP MODE ARGUMENT.
IN 1,DUMARG↔SKIPA↔HALT ;INPUT THE FILE.
RELEASE 1,
POP0J
DUMARG:0↔0
ENDR INFILE;5/30/73(BGB)---------------------------------------------
FILNAM: SIXBIT/ANA/
EXT: 0↔0
PPPN: 0↔0
CHRCNT: 0
TXTORG: 0
TXTPTR: 0
CHAR: 0
EOF: 0
PDL: BLOCK 20
CNT2: 0
SUBR(GETCHR)
SOSL CHRCNT↔GO[ILDB 1,TXTPTR↔JUMPE 1,.-1
AOS CNT2↔DAC 1,CHAR↔POP0J]
SETOM EOF↔SETZ 1,
POP0J
ENDR GETCHR
SA:
LAC P,[IOWD 20,PDL]
LAC JOBFF↔DAP TXTORG
CALL(INFILE)
DZM CNT
CALL(GETCHR)↔CAIE 1,"⊗"↔GO .-2
CALL(GETCHR)↔CAIE 1,"⊗"↔GO .-2
CALL(GETCHR)↔CAIE 1,14↔GO .-2
SETZM CNT2
L1: CALL(GETCHR)
SKIPE EOF↔GO L9
CAIN 1," "↔GO L2 ;WORD DELIMITER.
CAIN 1,"{"↔GO L3 ;XIP COMMANDS.
GO L1
;SPACE WORD BREAK.
L2: AOS CNT
CALL(GETCHR)
SKIPE EOF↔GO L9
CAIN 1," "↔GO L2+1
GO L1
;XIP COMMAND STRING.
L3: CALL(GETCHR)
SKIPE EOF↔GO L9
CAIE 1,"}"↔GO L3
GO L1
CNT: 0
CNT3: 0
L9: MOVE 1,CNT
IDIVI 1,=1000
IDIVI 2,=100
IDIVI 3,=10
JUMPN 1,X1
JUMPN 2,X2
JUMPN 3,X3
GO X4
X1: ADDI 1,60↔OUTCHR 1
X2: ADDI 2,60↔OUTCHR 2
X3: ADDI 3,60↔OUTCHR 3
X4: ADDI 4,60↔OUTCHR 4
EXIT
END SA